home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Colors.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-11-25  |  7.3 KB  |  179 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. MODULE Colors; (** ww 23 Jan 91 / RC 19.9.91**)
  3.   IMPORT Display, Texts, TextFrames, Viewers, MenuViewers, Oberon, Input, Files;
  4.   CONST Menu = "System.Close  System.Copy  System.Grow";
  5.     Cols = 16;  (* Number of Colors to be represented *)
  6.     MaxInt = 255;  (* maximum value for intensity *)
  7.     Left = 2; Middle = 1; Right = 0;  (* mouse buttons *)
  8.     Comp = 3; H = 0; L = 1; S = 2;  R = 0; G = 1; B = 2;  (* Just for clarifying some things later ... *)
  9.   TYPE
  10.     Frame = POINTER TO FrameDesc;
  11.     FrameDesc = RECORD(Display.FrameDesc)
  12.       beg: ARRAY 256 OF INTEGER;
  13.       n: INTEGER
  14.     END;
  15.     Components = ARRAY Comp OF REAL;
  16.     Color = RECORD
  17.       rgb: Components;
  18.       nr: INTEGER
  19.     END;
  20.     EditFrame = POINTER TO EditFrameDesc;
  21.     EditFrameDesc = RECORD(Display.FrameDesc)
  22.       beg: ARRAY Comp + 1 OF INTEGER;
  23.       col: Color;
  24.     END;
  25.     Msg = RECORD(Display.FrameMsg) END;
  26.   VAR w: Texts.Writer; task: Oberon.Task; grey: ARRAY 3 OF Display.Pattern;
  27.     PROCEDURE Load*;
  28.       VAR par: Oberon.ParList;
  29.         S: Texts.Scanner;
  30.         f: Files.File; R: Files.Rider;
  31.         col: SHORTINT; red, green, blue: CHAR;
  32.     BEGIN
  33.       Texts.WriteString(w, "Colors.Load ");
  34.       par := Oberon.Par;
  35.       Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
  36.       IF S.class = Texts.Name THEN
  37.         Texts.WriteString(w, S.s);
  38.         f := Files.Old(S.s);
  39.         IF f # NIL THEN
  40.           Files.Set(R, f, 0); col := 0;
  41.           REPEAT
  42.             Files.Read(R, red); Files.Read(R, green); Files.Read(R, blue);
  43.             Display.SetColor(col, ORD(red), ORD(green), ORD(blue));
  44.             INC(col)
  45.           UNTIL col = 16
  46.         ELSE Texts.WriteString(w, " not found")
  47.         END
  48.       ELSE Texts.WriteString(w, " no name")
  49.       END;
  50.       Texts.WriteLn(w);
  51.       Texts.Append(Oberon.Log, w.buf)
  52.     END Load;
  53.   PROCEDURE Int(v: REAL): INTEGER;
  54.   BEGIN RETURN SHORT(ENTIER(MaxInt * v))
  55.   END Int;
  56.   PROCEDURE UpdateDisp(VAR col: Color);
  57.   BEGIN Display.SetColor(col.nr, Int(col.rgb[0]), Int(col.rgb[1]), Int(col.rgb[2]))
  58.   END UpdateDisp;
  59.   PROCEDURE Change(VAR col: Color): BOOLEAN;
  60.     VAR d: ARRAY Comp OF INTEGER;  v: REAL; i: INTEGER; change: BOOLEAN;
  61.   BEGIN Display.GetColor(col.nr, d[0], d[1], d[2]); i := 0; change := FALSE;
  62.     WHILE i < Comp DO v := Int(col.rgb[i]);
  63.       IF v # d[i] THEN change := TRUE; col.rgb[i] := d[i] / MaxInt END;
  64.       INC(i)
  65.     END;
  66.     RETURN change
  67.   END Change;
  68.   PROCEDURE ShowRGB(f: EditFrame);
  69.     VAR x, w, r, i, h: INTEGER;
  70.   BEGIN w := f.W DIV (Comp + 1) + 1; r := f.W - w * (Comp + 1); i := 0; x := 0; f.beg[i] := x; Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  71.     WHILE i < Comp DO h := SHORT(ENTIER(f.H * f.col.rgb[i])); DEC(r);
  72.       IF r = 0 THEN DEC(w) END;
  73.       Display.ReplConst(i + 1, f.X + x, f.Y, w, h, Display.replace);
  74.       Display.ReplConst(Display.black, f.X + x, f.Y + h, w, f.H - h, Display.replace);
  75.       INC(x, w); INC(i); f.beg[i] := x
  76.     END;
  77.     Display.ReplConst(f.col.nr, f.X + x, f.Y, f.W - x, f.H, Display.replace)
  78.   END ShowRGB;
  79.   PROCEDURE EditRGB(f: EditFrame; x, y: INTEGER; keys: SET);
  80.     VAR backUp: Color; m: Msg;  keySum: SET; last: REAL; i: INTEGER;
  81.   BEGIN keySum := keys; x := x - f.X; i := 1; backUp := f.col;
  82.     WHILE (i <= Comp) & (f.beg[i] < x) DO INC(i) END;
  83.     IF i <= Comp THEN DEC(i); last := -1;
  84.       REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
  85.         Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y); y := y - f.Y;
  86.         IF y < 0 THEN y := 0 ELSIF y > f.H THEN y := f.H END;
  87.         f.col.rgb[i] := y / f.H;
  88.         IF f.col.rgb[i] # last THEN UpdateDisp(f.col); last := f.col.rgb[i];
  89.           Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  90.           Display.ReplConst(i + 1, f.X + f.beg[i], f.Y, f.beg[i + 1] - f.beg[i] , y, Display.replace);
  91.           Display.ReplConst(Display.black, f.X + f.beg[i], f.Y + y, f.beg[i + 1] - f.beg[i] , f.H - y, Display.replace);
  92.           Viewers.Broadcast(m)
  93.         END
  94.       UNTIL keys = {};
  95.       IF keySum # {Left} THEN f.col := backUp; UpdateDisp(backUp); ShowRGB(f) END
  96.     END
  97.   END EditRGB;
  98.   PROCEDURE HandleEdit(f: Display.Frame; VAR m: Display.FrameMsg);
  99.     VAR frame: EditFrame; v: Components;
  100.   BEGIN
  101.     WITH f: EditFrame DO
  102.       IF m IS Oberon.InputMsg THEN
  103.         WITH m: Oberon.InputMsg DO
  104.           IF m.id = Oberon.track THEN
  105.             IF m.keys = {} THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, m.X, m.Y);
  106.             ELSE EditRGB(f, m.X, m.Y, m.keys)
  107.             END
  108.           END
  109.         END
  110.       ELSIF (m IS Msg) & Change(f.col) THEN ShowRGB(f)
  111.       ELSIF m IS Oberon.CopyMsg THEN NEW(frame); frame^ := f^; m(Oberon.CopyMsg).F := frame
  112.       ELSIF m IS MenuViewers.ModifyMsg THEN
  113.         WITH m: MenuViewers.ModifyMsg DO f.Y := m.Y; f.H := m.H;
  114.           ShowRGB(f)
  115.         END
  116.       END
  117.     END
  118.   END HandleEdit;
  119.   PROCEDURE EditColor(colNr: INTEGER; rgb: BOOLEAN);
  120.     VAR f: EditFrame;  v: Viewers.Viewer;  col: Color;  x, y: INTEGER; dummy: BOOLEAN;
  121.   BEGIN col.nr := colNr; dummy := Change(col);
  122.     NEW(f); f.col := col; f.handle := HandleEdit; Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y);
  123.     v := MenuViewers.New(TextFrames.NewMenu("Color", Menu), f, TextFrames.menuH, x, y);
  124.     Texts.Write(w, " "); Texts.WriteInt(w, colNr, 0); Texts.Insert(v.dsc(TextFrames.Frame).text, 5, w.buf)
  125.   END EditColor;
  126.   PROCEDURE Show(f: Frame);
  127.     VAR i, r, n, w, x: INTEGER;
  128.   BEGIN n := f.n; w := f.W DIV n; r := f.W - w * n; i := 0; x := 0; INC(w);
  129.     WHILE i < n DO f.beg[i] := x;
  130.       IF r = 0 THEN DEC(w) END;
  131.       Display.ReplConst(i, f.X + x, f.Y, w, f.H, Display.replace); INC(x, w); INC(i); DEC(r)
  132.     END
  133.   END Show;
  134.   PROCEDURE Edit(f: Frame; x, y: INTEGER; keys: SET);
  135.     VAR keySum: SET; i: INTEGER;
  136.   BEGIN keySum := keys;
  137.     REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
  138.       Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y)
  139.     UNTIL keys = {};
  140.     IF (keySum = {Left}) OR (keySum = {Right}) THEN i := 1; x := x - f.X;
  141.       WHILE (i < f.n) & (f.beg[i] < x) DO INC(i) END;
  142.       EditColor(i-1, keySum = {Left})
  143.     END
  144.   END Edit;
  145.   PROCEDURE Handler(f: Display.Frame; VAR m: Display.FrameMsg);
  146.     VAR frame: Frame;
  147.   BEGIN
  148.     WITH f: Frame DO
  149.       IF m IS Oberon.InputMsg THEN
  150.         WITH m: Oberon.InputMsg DO
  151.           IF m.id = Oberon.track THEN
  152.             IF m.keys = {} THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, m.X, m.Y)
  153.             ELSE Edit(f, m.X, m.Y, m.keys)
  154.             END
  155.           END
  156.         END
  157.       ELSIF m IS Oberon.CopyMsg THEN NEW(frame); frame^ := f^; m(Oberon.CopyMsg).F := frame
  158.       ELSIF m IS MenuViewers.ModifyMsg THEN
  159.         WITH m: MenuViewers.ModifyMsg DO f.Y := m.Y; f.H := m.H; Show(f) END
  160.       END
  161.     END
  162.   END Handler;
  163.   PROCEDURE Open*;
  164.     VAR s: Texts.Scanner;  f: Frame; v: Viewers.Viewer;  x, y, n: INTEGER;
  165.   BEGIN Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  166.     IF s.class = Texts.Int THEN n := SHORT(s.i) ELSE n := Cols END;
  167.     Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y); NEW(f); f.handle := Handler; f.n := n;
  168.     v := MenuViewers.New(TextFrames.NewMenu("Colors", Menu), f, TextFrames.menuH, x, y)
  169.   END Open;
  170.   PROCEDURE* Activate;
  171.     VAR m: Msg;
  172.   BEGIN Viewers.Broadcast(m)
  173.   END Activate;
  174. BEGIN Texts.OpenWriter(w);
  175.   NEW(task); task.handle := Activate; task.safe := FALSE; Oberon.Install(task);
  176.   grey[0] := Display.grey0; grey[1] := Display.grey1; grey[2] := Display.grey2
  177. END Colors.
  178. Colors.Open
  179.